home *** CD-ROM | disk | FTP | other *** search
/ Softdisk G-S 144 / SGDS 144.2mg / SDGS.144 / PSL.SDA144 / A / MMXXVII.PRG (.txt) < prev    next >
Encoding:
Applesoft BASIC Source Code  |  1993-08-23  |  8.0 KB  |  191 lines  |  [FC] Applesoft BASIC Program (0x4001)
  1. 1 VE$ = "1.0"
  2. 3  TEXT : PRINT  CHR$(21):LV = 1
  3. 5  HGR : CALL 2304: POKE 48688, PEEK(0): POKE 48689, PEEK(1):D$ =  CHR$(4): GOTO 1000
  4. 8  HCOLOR= 5: HPLOT 18,24 TO 122,24 TO 127,29 TO 127,148 TO 122,152 TO 18,152 TO 13,147 TO 13,28 TO 18,24: RETURN 
  5. 9  HCOLOR= 4: HPLOT 0,0: CALL  -3082: RETURN 
  6. 20  POKE 0,SH: POKE 3,Y: POKE 2, INT(X/14) *2: POKE 1,X -7 * PEEK(2): CALL ML: RETURN 
  7. 50  POKE 0,X/7: POKE 2,Y: POKE 6,X -7 * PEEK(0): ROT= 1: RETURN 
  8. 90  VTAB 18: HTAB 2: PRINT  SPC( 33): RETURN 
  9. 100 X = 20 +21 *(CX -1):Y = 34 +24 *(CY -1):X = X -( INT(X/2) < >(X/2))
  10. 110 X = CX(CU):Y = CY(CU):SH = 58: IF CU <3  THEN SH = 54: GOTO 120
  11. 111  IF CU <6  THEN SH = 60: GOTO 120
  12. 112  IF CU <9  THEN SH = 56
  13. 120  IF O  THEN SH = SH +8
  14. 125  GOTO 20
  15. 200  GOSUB 100
  16. 210 K =  PEEK(49152): IF K <128  THEN 210
  17. 220 K = K -128: POKE 49168,0
  18. 230  IF K = 8  OR K = 21  OR K = 27  OR K = 32  THEN O = 3: GOSUB 100: GOSUB 8:O = 0: IF K = 8  THEN 250
  19. 231  IF K = 21  THEN 260
  20. 232  IF K = 27  THEN  FOR I = 4 TO 16: VTAB I: HTAB 20: PRINT  SPC( 15): NEXT : FOR I = 17 TO 19: VTAB I: HTAB 1: PRINT  SPC( 35): NEXT : RETURN 
  21. 233  IF K = 47  OR K = 63  THEN 500
  22. 234  IF K = 32  THEN 300
  23. 235  GOTO 210
  24. 250 CU = CU +1: IF CU = 12  THEN CU = 0
  25. 255  GOTO 200
  26. 260 CU = CU -1: IF CU =  -1  THEN CU = 11
  27. 265  GOTO 200
  28. 300  ON CU +1 GOTO 310,310,310,320,320,320,330,330,330,340,340,340
  29. 310 X = CU *2:J = X:Y = 1: GOSUB 2101: GOTO 410
  30. 320 X = (CU -3) *2:I = X:Y =  -1: GOSUB 2201: GOTO 400
  31. 330 X = 4 -2 *(CU -6):J = X:Y =  -1: GOSUB 2101: GOTO 410
  32. 340 X = 4 -2 *(CU -9):I = X:Y = 1: GOSUB 2201
  33. 400  FOR J = 0 TO 4:X = 22 +21 *J:X = X -( INT(X/2) < >(X/2)):Y = 34 +24 *I:SH = L%(J,I) *2: GOSUB 20: NEXT : GOTO 420
  34. 410  FOR I = 0 TO 4:X = 22 +21 *J:Y = 34 +24 *I:SH = L%(J,I) *2: GOSUB 20: NEXT 
  35. 420 TU = TU +1: GOSUB 550
  36. 430  FOR I = 0 TO 4: FOR J = 0 TO 4: IF L%(I,J) < >S%(I,J)  THEN J = 5:I = 5: NEXT : NEXT : GOTO 450
  37. 440  NEXT : NEXT : RETURN 
  38. 450  FOR I = 0 TO 4: FOR J = 0 TO 4: IF L%(I,J) < >S%(J,I)  THEN J = 5:I = 5: NEXT : NEXT : GOTO 200
  39. 460  NEXT : NEXT : RETURN 
  40. 500 I = CU: IF I >5  THEN I = 8 -I: IF I <0  THEN I = I +6
  41. 510 J = I +3: IF J >5  THEN J = J -6
  42. 530  VTAB 7 +J: HTAB 26: PRINT P$(GM,I):TU = TU +1: GOSUB 550: GOTO 200
  43. 550  VTAB 17: HTAB 26: PRINT "Turns: " SPC( TU <100) SPC( TU <10)TU: RETURN 
  44. 600  REM  PANACEA INPUT ANYTHING
  45. 610  FOR IN = L +1 TO 1  STEP  -1:IN$(IN -1) = " ": NEXT :IN$ = ""
  46. 620  HTAB IN +H: POKE 50,63 +192 *( PEEK(50) = 63): PRINT IN$(IN) CHR$(8);:T =  PEEK(49152): IF T <128  THEN 620
  47. 630  NORMAL : PRINT IN$(IN) CHR$(8);:T = T -128: POKE 49168,0: IF T >31  AND T <127  THEN IN$(IN) =  CHR$(T): PRINT IN$(IN);:IN = IN +(IN <L): GOTO 620
  48. 640  IF (T = 8  OR T = 4  OR T = 127)  AND (IN >0)  THEN IN$(IN) = " ":IN = IN -1: PRINT " " CHR$(8) CHR$(8);
  49. 650  IF T = 27  THEN IN$ = "": RETURN 
  50. 660  ON T < >13 GOTO 620: FOR I = 0 TO IN:IN$ = IN$ +IN$(I): NEXT : IF IN = 0  THEN IN$ = "": RETURN 
  51. 670  HTAB H +IN: PRINT " ":IN$ =  LEFT$(IN$, LEN(IN$) -1): RETURN 
  52. 700  POKE 32,1: POKE 33,33: POKE 34,17: POKE 35,19: PRINT  CHR$(12)
  53. 703  VTAB 18:A$ = "Set Play Level (1-9)": GOSUB 6100: HTAB 28: GET A$:LV =  VAL(A$): IF LV <1  THEN 703
  54. 705  PRINT  CHR$(12): PRINT  CHR$(20): RETURN 
  55. 1000 B$ = "           ":ML = 3840:TI = 2304: DIM L%(5,5),S%(5,5),P(19),P$(19,5),HS$(9,6),HS(9,6),CX(11),CY(11): GOSUB 40000: FOR I = 0 TO 19: FOR J = 0 TO 5: READ P$(I,J): NEXT :P(I) = I: NEXT 
  56. 1002  FOR I = 0 TO 11: READ CX(I): NEXT : FOR I = 0 TO 11: READ CY(I): NEXT : GOSUB 1006: GOTO 1020
  57. 1006  VTAB 19:A$ = "Press a key": GOSUB 6100: GET A$: RETURN 
  58. 1020  GOTO 20000
  59. 1025  GOSUB 6000
  60. 1030  FOR I = 0 TO 19:X =  RND(1) *20:Y = P(X):P(X) = P(I):P(I) = Y: NEXT :PG = 0:GP = 0
  61. 1036 QU = 0:QT = 0:NC = 0:NM = 0:TU = 0
  62. 1040  IF SC  THEN  GOSUB 7008: GOTO 1042
  63. 1041  GOSUB 7000
  64. 1042 GM = P(PG): FOR I = 0 TO 4  STEP 2: FOR J = 1 TO 5:L%(I,J -1) =  ASC( MID$ (P$(GM,I/2),J,1)) -65: NEXT : NEXT :L%(1,1) =  -1:L%(1,3) =  -1:L%(3,3) =  -1:L%(3,1) =  -1
  65. 1044  FOR I = 0 TO 4  STEP 2: FOR J = 1 TO 5:L%(J -1,I) =  ASC( MID$ (P$(GM,I/2 +3),J,1)) -65: NEXT : NEXT : FOR I = 0 TO 4: FOR J = 0 TO 4:S%(I,J) = L%(I,J): NEXT : NEXT 
  66. 1045  FOR J = 1 TO LV:Z =  INT( RND(1) *2): IF Z  THEN  GOSUB 2100: GOSUB 2200: GOTO 1050
  67. 1046  GOSUB 2200: GOSUB 2100
  68. 1050  NEXT : FOR I = 3 TO 15: VTAB I: HTAB 20: PRINT  SPC( 15): NEXT : VTAB 4: HTAB 25: PRINT "Playing": HTAB 25: PRINT "Level "LV
  69. 1052  VTAB 18: HTAB 1: PRINT "<- clockwise  ccw ->" SPC( 8): VTAB 19: HTAB 1: PRINT "SPACE turns cylinder   "
  70. 1054  VTAB 14: HTAB 25: PRINT "?: Hint": VTAB 19: HTAB 27: PRINT "ESC menu"
  71. 1060  GOSUB 2400:CU = 7
  72. 1066  GOSUB 200
  73. 1070  IF K = 27  THEN 1030
  74. 1071  FOR I = 17 TO 19: VTAB I: HTAB 1: PRINT  SPC( 35): NEXT 
  75. 1075 GP = GP +1: IF GP <3  THEN PG = PG +1: VTAB 18: HTAB 8: PRINT "Games left to play: "3 -GP: GOSUB 1006: GOTO 1042
  76. 1080 TU = (2 *LV *3)/TU:TU =  INT(TU *100):QU = 1
  77. 1100 LQ = TU: FOR I = 3 TO 15: VTAB I: HTAB 20: PRINT  SPC( 15): NEXT 
  78. 1110  VTAB 4: HTAB 23: PRINT "High Scores": VTAB 5: HTAB 25: PRINT "Level "LV: VTAB 7: HTAB 22:A$ = "Yours: " + STR$(LQ): IF   NOT LQ  THEN A$ = "The top five:"
  79. 1115  PRINT A$:J = 0: IF   NOT QU  THEN 1150
  80. 1120  FOR I = 1 TO 5: IF LQ < = HS(LV,I)  THEN  NEXT : GOTO 1150
  81. 1130 J = I:I = 5: NEXT : FOR I = 5 TO J  STEP  -1:HS$(LV,I +1) = HS$(LV,I):HS(LV,I +1) = HS(LV,I): NEXT :HS(LV,J) = LQ:HS$(LV,J) = " "
  82. 1150  FOR I = 1 TO 5: VTAB 8 +I: HTAB 22: PRINT HS$(LV,I);: HTAB 33: PRINT  SPC( HS(LV,I) <100) SPC( HS(LV,I) <10)HS(LV,I): NEXT 
  83. 1160  IF J  THEN  VTAB 16: HTAB 23: PRINT "Enter name!": VTAB 8 +J:H = 22:L = 10: GOSUB 610:HS$(LV,J) = IN$
  84. 1170  VTAB 19:A$ = "Press a key to continue": GOSUB 6100: GET A$: VTAB 19: HTAB 1: PRINT  SPC( 35):SC = 1: FOR I = 3 TO 16: VTAB I: HTAB 20: PRINT  SPC( 16): NEXT : GOTO 1030
  85. 2000  GOSUB 8:SH = 52:X = 36:Y = 52: GOSUB 20:X = 78: GOSUB 20:Y = Y +48: GOSUB 20:X = 36: GOSUB 20
  86. 2010  HCOLOR= 6: FOR I = 2 TO 17  STEP 3: HPLOT I *7 +3 +((I/2) =  INT(I/2)),28 TO I *7 +3 +((I/2) =  INT(I/2)),148: HPLOT 18,I *8 +12 TO 122,I *8 +12: NEXT 
  87. 2030  RETURN 
  88. 2100  GOSUB 2300
  89. 2101  IF Y =  -1  THEN Z = L%(X,0): FOR Q = 1 TO 4:L%(X,Q -1) = L%(X,Q): NEXT :L%(X,4) = Z: RETURN 
  90. 2110 Z = L%(X,4): FOR Q = 3 TO 0  STEP  -1:L%(X,Q +1) = L%(X,Q): NEXT :L%(X,0) = Z: RETURN 
  91. 2200  GOSUB 2300
  92. 2201  IF Y =  -1  THEN Z = L%(0,X): FOR Q = 1 TO 4:L%(Q -1,X) = L%(Q,X): NEXT :L%(4,X) = Z: RETURN 
  93. 2210 Z = L%(4,X): FOR Q = 3 TO 0  STEP  -1:L%(Q +1,X) = L%(Q,X): NEXT :L%(0,X) = Z: RETURN 
  94. 2300 X =  INT( RND(1) *3) *2:Y =  INT( RND(1) *2) *2 -1: RETURN 
  95. 2400  FOR I = 0 TO 4: FOR J = 0 TO 4:X = 22 +21 *I:Y = 34 +24 *J:SH = L%(I,J) *2: IF SH > -1  THEN X = X -( INT(X/2) < >(X/2)): GOSUB 20
  96. 2410  NEXT : NEXT 
  97. 4999  REM  DRAW THE BOARD
  98. 5000  RETURN 
  99. 5999  REM  TITLE PAGE
  100. 6000  GOSUB 9: HCOLOR= 5: HPLOT 35,35 TO 244,35: VTAB 19:VE = 35 - LEN(VE$): HTAB VE: PRINT VE$
  101. 6020  VTAB 2: GOSUB 6120: VTAB 5:A$ = "Copyright 1993 Softdisk Publishing": GOSUB 6100: VTAB 6:A$ = "All rights reserved.": GOSUB 6100
  102. 6040 A$ = "Published on #144.": GOSUB 6100:A$ = "Subscriptions: 1-800-831-2694": GOSUB 6100
  103. 6050  PRINT : PRINT : PRINT :A$ = "Changing this notice is quite": GOSUB 6100:A$ = "illegal, you know.": GOSUB 6100: HPLOT 35,84 TO 244,84
  104. 6060  PRINT : PRINT :A$ = "Press a key to continue.": GOSUB 6100: HCOLOR= 6: HPLOT 34,102 TO 244,102: HPLOT 34,134 TO 244,134
  105. 6070  GET A$
  106. 6090  VTAB 19: HTAB VE: PRINT  SPC(  LEN(VE$)): RETURN 
  107. 6100  HTAB (35 - LEN(A$))/2 +1: PRINT A$: RETURN 
  108. 6120 XH = 0: GOSUB 6150
  109. 6130  VTAB 1: HTAB 19: PRINT "by Peter Rokitski": VTAB 2: HTAB 22: PRINT "Thanks Fender!": RETURN 
  110. 6150 A$ = "turn a word":Y = 0: PRINT  CHR$(20)
  111. 6666 X = XH: FOR Q = 1 TO  LEN(A$):SH = ( ASC( MID$ (A$,Q,1)) -97) *2: IF SH =  >0  THEN  GOSUB 20:X = X +6
  112. 6669 X = X +8: NEXT : RETURN 
  113. 6999  REM  MAIN MENU
  114. 7000  GOSUB 9: GOSUB 6120: GOSUB 2000
  115. 7008  VTAB 6: HTAB 24: PRINT "Main Menu": VTAB 14: HTAB 22: PRINT "Which number?": POKE 32,22: POKE 33,16
  116. 7010  VTAB 8: PRINT "1. Play": PRINT "2. High Scores": PRINT "3. Level: "LV: PRINT "4. Instructions": PRINT "5. Quit"
  117. 7015  PRINT  CHR$(20)
  118. 7020 P =  RND(1):P =  PEEK(49152): IF P <128  THEN 7020
  119. 7025  POKE 49168,0
  120. 7030  IF P = 155  THEN  GOSUB 8000
  121. 7050  IF P = 177  THEN PP = 1: RETURN 
  122. 7065  IF P = 181  THEN  GOSUB 8000
  123. 7066  IF P = 179  THEN  GOSUB 700: GOTO 7008
  124. 7067  IF P = 180  THEN  GOSUB 10000: GOTO 7000
  125. 7070  IF P < >178  THEN 7020
  126. 7080 QU = 0:LQ = 0: POP : GOTO 1100
  127. 7999  REM  QUIT
  128. 8000  VTAB 18:A$ = "Do you want to quit? (Y/N)": GOSUB 6100
  129. 8010  GET A$
  130. 8020  IF A$ = "N"  OR A$ = "n"  THEN 90
  131. 8030  IF A$ < >"Y"  AND A$ < >"y"  THEN 8010
  132. 8035  GOTO 30000
  133. 10000 XH = 80: GOSUB 9: GOSUB 6150: VTAB 3: PRINT " You are shown a 5x5 grid with 21": PRINT "letters in it. The letters form 6": PRINT "five letter words; but they were"
  134. 10010  PRINT "messed up by turning the cylinders.";: PRINT "Your task is to get the words back": PRINT "by quick twists of the cylinders.": PRINT 
  135. 10020  PRINT " Move the highlight arrow around": PRINT "the grid with the arrow keys. Press";: PRINT "RETURN to turn the cylinder in the": PRINT "direction the arrow points."
  136. 10025  PRINT : PRINT " A cylinder is a horizontal or": PRINT "vertical string of five letters.": PRINT "When turned, the farthest letter": PRINT "ends up next to the arrow and all": PRINT "others move one space."
  137. 10030  GOSUB 10040: GOTO 10065
  138. 10040 A$ = "|/-\":A = 0
  139. 10050 A = A +1:A = A -4 *(A = 5): VTAB 19: HTAB 35: PRINT  MID$ (A$,A,1): IF  PEEK(49152) <128  THEN 10050
  140. 10060  POKE 49168,0: RETURN 
  141. 10065  GOSUB 9: GOSUB 6150: VTAB 3
  142. 10070  PRINT " The difficulty level determines": PRINT "how many twists are applied at the": PRINT "beginning to scramble the grid."
  143. 10100  PRINT : PRINT " Pressing `?' reveals the word that";: PRINT "goes where the cursor is pointing.": PRINT "Every hint you get lowers your": PRINT "final score."
  144. 10110  PRINT : PRINT " You need to complete three games": PRINT "on a level to be considered for": PRINT "the high score list."
  145. 10130  PRINT : PRINT " Thanks to Fender Tucker for his": PRINT "original program on our Commodore": PRINT "publication!"
  146. 10140  GOTO 10040
  147. 20000  REM  READ HIGH SCORES
  148. 20010  ONERR  GOTO 20050
  149. 20020  PRINT D$"openmmxxvii.hs": PRINT D$"readmmxxvii.hs"
  150. 20030  FOR I = 1 TO 9: FOR J = 0 TO 5: INPUT HS$(I,J):HS$(I,J) =  LEFT$(HS$(I,J) +B$,11): INPUT HS(I,J): NEXT : NEXT 
  151. 20040  POKE 216,0: PRINT D$"close": GOTO 1025
  152. 20050  POKE 216,0: FOR I = 1 TO 9: FOR J = 0 TO 5:HS$(I,J) = "----------":HS(I,J) = 0: NEXT : NEXT : PRINT D$"close": GOTO 1025
  153. 30000  REM WRITE HIGH SCORES
  154. 30005  PRINT  CHR$(20): ONERR  GOTO 30050
  155. 30010  PRINT D$"openmmxxvii.hs": PRINT D$"writemmxxvii.hs"
  156. 30020  FOR I = 1 TO 9: FOR J = 0 TO 5: PRINT HS$(I,J): PRINT HS(I,J): NEXT : NEXT : PRINT D$"close"
  157. 30030  PRINT D$"bye"
  158. 30050  PRINT  CHR$(12): POKE 32,8: VTAB 10: IF  PEEK(222) = 4  THEN  PRINT "Disk locked";: GOTO 31000
  159. 30060  PRINT "Disk error";
  160. 31000  PRINT " while saving.": PRINT "Try again or Quit (T/Q)?": POKE 216,0
  161. 31010  GET A$: IF A$ = "t"  OR A$ = "T"  THEN  PRINT D$"close": GOTO 30000
  162. 31020  IF A$ < >"q"  AND A$ < >"Q"  THEN 31010
  163. 31030  PRINT D$"bye"
  164. 40000  HCOLOR= 6: HPLOT 0,25 TO 278,25 TO 278,145 TO 0,145 TO 0,25: HCOLOR= 5: HPLOT 3,85 TO 276,85
  165. 40005  VTAB 4:A$ = "TURN A WORD": GOSUB 6100:A$ = "is the copyrighted work of": GOSUB 6100
  166. 40010 A$ = "SOFTDISK PUBLISHING.": GOSUB 6100:A$ = "It is not meant for distribution": GOSUB 6100:A$ = "as public domain or shareware.": GOSUB 6100
  167. 40020  PRINT :A$ = "For help, information or to": GOSUB 6100:A$ = "report illegal distribution,": GOSUB 6100
  168. 40030 A$ = "call SOFTDISK at:": GOSUB 6100:A$ = "1-800-831-2694 or": GOSUB 6100:A$ = "1-318-221-8718.": GOSUB 6100
  169. 40050  RETURN 
  170. 50000  DATA ALERT,MEANT,DREAM,AIMED,EVADE,TOTEM
  171. 50001  DATA GRAIN,NOTED,RACER,GONER,ANTIC,NADIR
  172. 50002  DATA MOWER,TREAT,HATER,MATCH,WHEAT,ROTOR
  173. 50003  DATA CHANT,PAGED,DANDY,CUPID,ARGON,TODAY
  174. 50004  DATA FELON,TIMER,DANCE,FETID,LEMON,NERVE
  175. 50005  DATA STUNT,ADDER,EGRET,SHAPE,UNDER,TAROT
  176. 50006  DATA PARTY,ALOHA,EATEN,PLACE,ROOST,YEARN
  177. 50007  DATA FENCE,AMISS,DWELL,FRAUD,NAIVE,EASEL
  178. 50008  DATA GROVE,CREDO,ORATE,GECKO,OPERA,ERODE
  179. 50009  DATA JAUNT,UNCUT,THEIR,JOUST,UNCLE,TUTOR
  180. 50010  DATA SPITE,TAPER,NUTTY,SATIN,INPUT,EARLY
  181. 50011  DATA CRAZY,NIECE,ENDED,CANOE,AMEND,YIELD
  182. 50012  DATA WATER,TRAIN,HITCH,WATCH,TRAIT,RANCH
  183. 50013  DATA ABOVE,IDIOT,OCEAN,AMIGO,OLIVE,EATEN
  184. 50014  DATA SMALL,BEING,EAGER,SABLE,AGING,LAGER
  185. 50015  DATA FLOSS,UNDUE,FORUM,FLUFF,ORDER,STEAM
  186. 50016  DATA FALSE,INPUT,TARDY,FLIRT,LEPER,ENTRY
  187. 50017  DATA BLIMP,AMPLE,SOLID,BRASS,IMPEL,PLEAD
  188. 50018  DATA STONE,ACTOR,FUROR,STAFF,OTTER,ERROR
  189. 50019  DATA PILOT,INANE,TITLE,PAINT,LEAST,THEME
  190. 51000  DATA 20,62,106,124,124,124,106,62,20,6,6,6
  191. 51100  DATA 18,18,18,32,80,128,150,150,150,128,80,32